home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / gc / finalize.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  18.8 KB  |  635 lines  |  [TEXT/ttxt]
  1. /*
  2.  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
  3.  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
  4.  
  5.  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
  6.  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
  7.  *
  8.  * Permission is hereby granted to use or copy this program
  9.  * for any purpose,  provided the above notices are retained on all copies.
  10.  * Permission to modify the code and to distribute modified code is granted,
  11.  * provided the above notices are retained, and a notice that the code was
  12.  * modified is included with the above copyright notice.
  13.  */
  14. /* Boehm, January 28, 1995 4:26 pm PST */
  15. # define I_HIDE_POINTERS
  16. # include "gc_priv.h"
  17. # include "gc_mark.h"
  18.  
  19. /* Type of mark procedure used for marking from finalizable object.    */
  20. /* This procedure normally does not mark the object, only its        */
  21. /* descendents.                                */
  22. typedef void finalization_mark_proc(/* ptr_t finalizable_obj_ptr */); 
  23.  
  24. # define HASH3(addr,size,log_size) \
  25.     ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
  26.     & ((size) - 1))
  27. #define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
  28.  
  29. struct hash_chain_entry {
  30.     word hidden_key;
  31.     struct hash_chain_entry * next;
  32. };
  33.  
  34. unsigned GC_finalization_failures = 0;
  35.     /* Number of finalization requests that failed for lack of memory. */
  36.  
  37. static struct disappearing_link {
  38.     struct hash_chain_entry prolog;
  39. #   define dl_hidden_link prolog.hidden_key
  40.                 /* Field to be cleared.        */
  41. #   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
  42. #   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
  43.  
  44.     word dl_hidden_obj;        /* Pointer to object base    */
  45. } **dl_head = 0;
  46.  
  47. static signed_word log_dl_table_size = -1;
  48.             /* Binary log of                */
  49.             /* current size of array pointed to by dl_head.    */
  50.             /* -1 ==> size is 0.                */
  51.  
  52. word GC_dl_entries = 0;    /* Number of entries currently in disappearing    */
  53.             /* link table.                    */
  54.  
  55. static struct finalizable_object {
  56.     struct hash_chain_entry prolog;
  57. #   define fo_hidden_base prolog.hidden_key
  58.                 /* Pointer to object base.    */
  59. #   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
  60. #   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
  61.     GC_finalization_proc fo_fn;    /* Finalizer.            */
  62.     ptr_t fo_client_data;
  63.     word fo_object_size;    /* In bytes.            */
  64.     finalization_mark_proc * fo_mark_proc;    /* Mark-through procedure */
  65. } **fo_head = 0;
  66.  
  67. struct finalizable_object * GC_finalize_now = 0;
  68.     /* LIst of objects that should be finalized now.    */
  69.  
  70. static signed_word log_fo_table_size = -1;
  71.  
  72. word GC_fo_entries = 0;
  73.  
  74. # ifdef SRC_M3
  75. void GC_push_finalizer_structures()
  76. {
  77.     GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
  78.     GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
  79. }
  80. # endif
  81.  
  82. # define ALLOC(x, t) t *x = GC_NEW(t)
  83.  
  84. /* Double the size of a hash table. *size_ptr is the log of its current    */
  85. /* size.  May be a noop.                        */
  86. /* *table is a pointer to an array of hash headers.  If we succeed, we    */
  87. /* update both *table and *log_size_ptr.                */
  88. /* Lock is held.  Signals are disabled.                    */
  89. void GC_grow_table(table, log_size_ptr)
  90. struct hash_chain_entry ***table;
  91. signed_word * log_size_ptr;
  92. {
  93.     register word i;
  94.     register struct hash_chain_entry *p;
  95.     int log_old_size = *log_size_ptr;
  96.     register int log_new_size = log_old_size + 1;
  97.     word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
  98.     register word new_size = 1 << log_new_size;
  99.     struct hash_chain_entry **new_table = (struct hash_chain_entry **)
  100.         GC_generic_malloc_inner_ignore_off_page(
  101.             (size_t)new_size * sizeof(struct hash_chain_entry *), NORMAL);
  102.     
  103.     if (new_table == 0) {
  104.         if (table == 0) {
  105.             ABORT("Insufficient space for initial table allocation");
  106.         } else {
  107.             return;
  108.         }
  109.     }
  110.     for (i = 0; i < old_size; i++) {
  111.       p = (*table)[i];
  112.       while (p != 0) {
  113.         register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
  114.         register struct hash_chain_entry *next = p -> next;
  115.         register int new_hash = HASH3(real_key, new_size, log_new_size);
  116.         
  117.         p -> next = new_table[new_hash];
  118.         new_table[new_hash] = p;
  119.         p = next;
  120.       }
  121.     }
  122.     *log_size_ptr = log_new_size;
  123.     *table = new_table;
  124. }
  125.  
  126. # if defined(__STDC__) || defined(__cplusplus)
  127.     int GC_register_disappearing_link(extern_ptr_t * link)
  128. # else
  129.     int GC_register_disappearing_link(link)
  130.     extern_ptr_t * link;
  131. # endif
  132. {
  133.     ptr_t base;
  134.     
  135.     base = (ptr_t)GC_base((extern_ptr_t)link);
  136.     if (base == 0)
  137.         ABORT("Bad arg to GC_register_disappearing_link");
  138.     return(GC_general_register_disappearing_link(link, base));
  139. }
  140.  
  141. # if defined(__STDC__) || defined(__cplusplus)
  142.     int GC_general_register_disappearing_link(extern_ptr_t * link,
  143.                               extern_ptr_t obj)
  144. # else
  145.     int GC_general_register_disappearing_link(link, obj)
  146.     extern_ptr_t * link;
  147.     extern_ptr_t obj;
  148. # endif
  149.  
  150. {
  151.     struct disappearing_link *curr_dl;
  152.     int index;
  153.     struct disappearing_link * new_dl;
  154.     DCL_LOCK_STATE;
  155.     
  156.     if ((word)link & (ALIGNMENT-1))
  157.         ABORT("Bad arg to GC_general_register_disappearing_link");
  158. #   ifdef THREADS
  159.         DISABLE_SIGNALS();
  160.         LOCK();
  161. #   endif
  162.     if (log_dl_table_size == -1
  163.         || GC_dl_entries > ((word)1 << log_dl_table_size)) {
  164. #    ifndef THREADS
  165.         DISABLE_SIGNALS();
  166. #    endif
  167.         GC_grow_table((struct hash_chain_entry ***)(&dl_head),
  168.                   &log_dl_table_size);
  169. #    ifdef PRINTSTATS
  170.         GC_printf1("Grew dl table to %lu entries\n",
  171.                 (unsigned long)(1 << log_dl_table_size));
  172. #    endif
  173. #    ifndef THREADS
  174.         ENABLE_SIGNALS();
  175. #    endif
  176.     }
  177.     index = HASH2(link, log_dl_table_size);
  178.     curr_dl = dl_head[index];
  179.     for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
  180.         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
  181.             curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
  182. #        ifdef THREADS
  183.                 UNLOCK();
  184.                 ENABLE_SIGNALS();
  185. #        endif
  186.             return(1);
  187.         }
  188.     }
  189. #   ifdef THREADS
  190.       new_dl = (struct disappearing_link *)
  191.         GC_generic_malloc_inner(sizeof(struct disappearing_link),NORMAL);
  192. #   else
  193.       new_dl = GC_NEW(struct disappearing_link);
  194. #   endif
  195.     if (new_dl != 0) {
  196.         new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
  197.         new_dl -> dl_hidden_link = HIDE_POINTER(link);
  198.         dl_set_next(new_dl, dl_head[index]);
  199.         dl_head[index] = new_dl;
  200.         GC_dl_entries++;
  201.     } else {
  202.         GC_finalization_failures++;
  203.     }
  204. #   ifdef THREADS
  205.         UNLOCK();
  206.         ENABLE_SIGNALS();
  207. #   endif
  208.     return(0);
  209. }
  210.  
  211. # if defined(__STDC__) || defined(__cplusplus)
  212.     int GC_unregister_disappearing_link(extern_ptr_t * link)
  213. # else
  214.     int GC_unregister_disappearing_link(link)
  215.     extern_ptr_t * link;
  216. # endif
  217. {
  218.     struct disappearing_link *curr_dl, *prev_dl;
  219.     int index;
  220.     DCL_LOCK_STATE;
  221.     
  222.     DISABLE_SIGNALS();
  223.     LOCK();
  224.     index = HASH2(link, log_dl_table_size);
  225.     if (((unsigned long)link & (ALIGNMENT-1))) goto out;
  226.     prev_dl = 0; curr_dl = dl_head[index];
  227.     while (curr_dl != 0) {
  228.         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
  229.             if (prev_dl == 0) {
  230.                 dl_head[index] = dl_next(curr_dl);
  231.             } else {
  232.                 dl_set_next(prev_dl, dl_next(curr_dl));
  233.             }
  234.             GC_dl_entries--;
  235.             UNLOCK();
  236.             ENABLE_SIGNALS();
  237.             GC_free((extern_ptr_t)curr_dl);
  238.             return(1);
  239.         }
  240.         prev_dl = curr_dl;
  241.         curr_dl = dl_next(curr_dl);
  242.     }
  243. out:
  244.     UNLOCK();
  245.     ENABLE_SIGNALS();
  246.     return(0);
  247. }
  248.  
  249. /* Possible finalization_marker procedures.  Note that mark stack    */
  250. /* overflow is handled by the caller, and is not a disaster.        */
  251. void GC_normal_finalize_mark_proc(p)
  252. ptr_t p;
  253. {
  254.     hdr * hhdr = HDR(p);
  255.     
  256.     PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top,
  257.          &(GC_mark_stack[GC_mark_stack_size]));
  258. }
  259.  
  260. /* This only pays very partial attention to the mark descriptor.    */
  261. /* It does the right thing for normal and atomic objects, and treats    */
  262. /* most others as normal.                        */
  263. void GC_ignore_self_finalize_mark_proc(p)
  264. ptr_t p;
  265. {
  266.     hdr * hhdr = HDR(p);
  267.     word descr = hhdr -> hb_descr;
  268.     ptr_t q, r;
  269.     ptr_t limit;
  270.     
  271.     if ((descr & DS_TAGS) == DS_LENGTH) {
  272.        limit = p + descr - sizeof(word);
  273.     } else {
  274.        limit = p + WORDS_TO_BYTES(hhdr -> hb_sz - 1);
  275.     }
  276.     for (q = p; q <= limit; q += ALIGNMENT) {
  277.         r = *(ptr_t *)q;
  278.         if (r < p || r > limit) {
  279.             GC_PUSH_ONE_HEAP((word)r);
  280.         }
  281.     }
  282. }
  283.  
  284. /*ARGSUSED*/
  285. void GC_null_finalize_mark_proc(p)
  286. ptr_t p;
  287. {
  288. }
  289.  
  290.  
  291.  
  292. /* Register a finalization function.  See gc.h for details.    */
  293. /* in the nonthreads case, we try to avoid disabling signals,    */
  294. /* since it can be expensive.  Threads packages typically    */
  295. /* make it cheaper.                        */
  296. void GC_register_finalizer_inner(obj, fn, cd, ofn, ocd, mp)
  297. extern_ptr_t obj;
  298. GC_finalization_proc fn;
  299. extern_ptr_t cd;
  300. GC_finalization_proc * ofn;
  301. extern_ptr_t * ocd;
  302. finalization_mark_proc * mp;
  303. {
  304.     ptr_t base;
  305.     struct finalizable_object * curr_fo, * prev_fo;
  306.     int index;
  307.     struct finalizable_object *new_fo;
  308.     DCL_LOCK_STATE;
  309.  
  310. #   ifdef THREADS
  311.     DISABLE_SIGNALS();
  312.     LOCK();
  313. #   endif
  314.     if (log_fo_table_size == -1
  315.         || GC_fo_entries > ((word)1 << log_fo_table_size)) {
  316. #    ifndef THREADS
  317.             DISABLE_SIGNALS();
  318. #    endif
  319.         GC_grow_table((struct hash_chain_entry ***)(&fo_head),
  320.                   &log_fo_table_size);
  321. #    ifdef PRINTSTATS
  322.         GC_printf1("Grew fo table to %lu entries\n",
  323.                 (unsigned long)(1 << log_fo_table_size));
  324. #    endif
  325. #    ifndef THREADS
  326.         ENABLE_SIGNALS();
  327. #    endif
  328.     }
  329.     /* in the THREADS case signals are disabled and we hold allocation    */
  330.     /* lock; otherwise neither is true.  Proceed carefully.        */
  331.     base = (ptr_t)obj;
  332.     index = HASH2(base, log_fo_table_size);
  333.     prev_fo = 0; curr_fo = fo_head[index];
  334.     while (curr_fo != 0) {
  335.         if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
  336.             /* Interruption by a signal in the middle of this    */
  337.             /* should be safe.  The client may see only *ocd    */
  338.             /* updated, but we'll declare that to be his    */
  339.             /* problem.                        */
  340.             if (ocd) *ocd = (extern_ptr_t) curr_fo -> fo_client_data;
  341.             if (ofn) *ofn = curr_fo -> fo_fn;
  342.             /* Delete the structure for base. */
  343.                 if (prev_fo == 0) {
  344.                   fo_head[index] = fo_next(curr_fo);
  345.                 } else {
  346.                   fo_set_next(prev_fo, fo_next(curr_fo));
  347.                 }
  348.             if (fn == 0) {
  349.                 GC_fo_entries--;
  350.                   /* May not happen if we get a signal.  But a high    */
  351.                   /* estimate will only make the table larger than    */
  352.                   /* necessary.                        */
  353. #        ifndef THREADS
  354.                   GC_free((extern_ptr_t)curr_fo);
  355. #        endif
  356.             } else {
  357.                 curr_fo -> fo_fn = fn;
  358.                 curr_fo -> fo_client_data = (ptr_t)cd;
  359.                 curr_fo -> fo_mark_proc = mp;
  360.         /* Reinsert it.  We deleted it first to maintain    */
  361.         /* consistency in the event of a signal.        */
  362.         if (prev_fo == 0) {
  363.                   fo_head[index] = curr_fo;
  364.                 } else {
  365.                   fo_set_next(prev_fo, curr_fo);
  366.                 }
  367.             }
  368. #        ifdef THREADS
  369.                 UNLOCK();
  370.                 ENABLE_SIGNALS();
  371. #        endif
  372.             return;
  373.         }
  374.         prev_fo = curr_fo;
  375.         curr_fo = fo_next(curr_fo);
  376.     }
  377.     if (ofn) *ofn = 0;
  378.     if (ocd) *ocd = 0;
  379.     if (fn == 0) {
  380. #    ifdef THREADS
  381.             UNLOCK();
  382.             ENABLE_SIGNALS();
  383. #    endif
  384.         return;
  385.     }
  386. #   ifdef THREADS
  387.       new_fo = (struct finalizable_object *)
  388.         GC_generic_malloc_inner(sizeof(struct finalizable_object),NORMAL);
  389. #   else
  390.       new_fo = GC_NEW(struct finalizable_object);
  391. #   endif
  392.     if (new_fo != 0) {
  393.         new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
  394.     new_fo -> fo_fn = fn;
  395.     new_fo -> fo_client_data = (ptr_t)cd;
  396.     new_fo -> fo_object_size = GC_size(base);
  397.     new_fo -> fo_mark_proc = mp;
  398.     fo_set_next(new_fo, fo_head[index]);
  399.     GC_fo_entries++;
  400.     fo_head[index] = new_fo;
  401.     } else {
  402.          GC_finalization_failures++;
  403.     }
  404. #   ifdef THREADS
  405.         UNLOCK();
  406.         ENABLE_SIGNALS();
  407. #   endif
  408. }
  409.  
  410. # if defined(__STDC__)
  411.     void GC_register_finalizer(void * obj,
  412.                    GC_finalization_proc fn, void * cd,
  413.                    GC_finalization_proc *ofn, void ** ocd)
  414. # else
  415.     void GC_register_finalizer(obj, fn, cd, ofn, ocd)
  416.     extern_ptr_t obj;
  417.     GC_finalization_proc fn;
  418.     extern_ptr_t cd;
  419.     GC_finalization_proc * ofn;
  420.     extern_ptr_t * ocd;
  421. # endif
  422. {
  423.     GC_register_finalizer_inner(obj, fn, cd, ofn,
  424.                     ocd, GC_normal_finalize_mark_proc);
  425. }
  426.  
  427. # if defined(__STDC__)
  428.     void GC_register_finalizer_ignore_self(void * obj,
  429.                    GC_finalization_proc fn, void * cd,
  430.                    GC_finalization_proc *ofn, void ** ocd)
  431. # else
  432.     void GC_register_finalizer_ignore_self(obj, fn, cd, ofn, ocd)
  433.     extern_ptr_t obj;
  434.     GC_finalization_proc fn;
  435.     extern_ptr_t cd;
  436.     GC_finalization_proc * ofn;
  437.     extern_ptr_t * ocd;
  438. # endif
  439. {
  440.     GC_register_finalizer_inner(obj, fn, cd, ofn,
  441.                     ocd, GC_ignore_self_finalize_mark_proc);
  442. }
  443.  
  444. # if defined(__STDC__)
  445.     void GC_register_finalizer_no_order(void * obj,
  446.                    GC_finalization_proc fn, void * cd,
  447.                    GC_finalization_proc *ofn, void ** ocd)
  448. # else
  449.     void GC_register_finalizer_no_order(obj, fn, cd, ofn, ocd)
  450.     extern_ptr_t obj;
  451.     GC_finalization_proc fn;
  452.     extern_ptr_t cd;
  453.     GC_finalization_proc * ofn;
  454.     extern_ptr_t * ocd;
  455. # endif
  456. {
  457.     GC_register_finalizer_inner(obj, fn, cd, ofn,
  458.                     ocd, GC_null_finalize_mark_proc);
  459. }
  460.  
  461.  
  462. /* Called with world stopped.  Cause disappearing links to disappear,    */
  463. /* and invoke finalizers.                        */
  464. void GC_finalize()
  465. {
  466.     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
  467.     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
  468.     ptr_t real_ptr, real_link;
  469.     register int i;
  470.     int dl_size = (log_dl_table_size == -1 ) ? 0 : (1 << log_dl_table_size);
  471.     int fo_size = (log_fo_table_size == -1 ) ? 0 : (1 << log_fo_table_size);
  472.     
  473.   /* Make disappearing links disappear */
  474.     for (i = 0; i < dl_size; i++) {
  475.       curr_dl = dl_head[i];
  476.       prev_dl = 0;
  477.       while (curr_dl != 0) {
  478.         real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
  479.         real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
  480.         if (!GC_is_marked(real_ptr)) {
  481.             *(word *)real_link = 0;
  482.             next_dl = dl_next(curr_dl);
  483.             if (prev_dl == 0) {
  484.                 dl_head[i] = next_dl;
  485.             } else {
  486.                 dl_set_next(prev_dl, next_dl);
  487.             }
  488.             GC_clear_mark_bit((ptr_t)curr_dl);
  489.             GC_dl_entries--;
  490.             curr_dl = next_dl;
  491.         } else {
  492.             prev_dl = curr_dl;
  493.             curr_dl = dl_next(curr_dl);
  494.         }
  495.       }
  496.     }
  497.   /* Mark all objects reachable via chains of 1 or more pointers    */
  498.   /* from finalizable objects.                        */
  499. #   ifdef PRINTSTATS
  500.         if (GC_mark_state != MS_NONE) ABORT("Bad mark state");
  501. #   endif
  502.     for (i = 0; i < fo_size; i++) {
  503.       for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
  504.         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
  505.         if (!GC_is_marked(real_ptr)) {
  506.             (*(curr_fo -> fo_mark_proc))(real_ptr);
  507.             while (!GC_mark_stack_empty()) GC_mark_from_mark_stack();
  508.             if (GC_mark_state != MS_NONE) {
  509.                 /* Mark stack overflowed. Very unlikely. */
  510. #        ifdef PRINTSTATS
  511.             if (GC_mark_state != MS_INVALID) ABORT("Bad mark state");
  512.             GC_printf0("Mark stack overflowed in finalization!!\n");
  513. #        endif
  514.         /* Make mark bits consistent again.  Forget about    */
  515.         /* finalizing this object for now.            */
  516.             GC_set_mark_bit(real_ptr);
  517.             while (!GC_mark_some());
  518.             }
  519.             if (GC_is_marked(real_ptr)) {
  520.                 WARN("Finalization cycle involving %ld\n", real_ptr);
  521.             }
  522.         }
  523.         
  524.       }
  525.     }
  526.   /* Enqueue for finalization all objects that are still        */
  527.   /* unreachable.                            */
  528.     for (i = 0; i < fo_size; i++) {
  529.       curr_fo = fo_head[i];
  530.       prev_fo = 0;
  531.       while (curr_fo != 0) {
  532.         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
  533.         if (!GC_is_marked(real_ptr)) {
  534.             GC_set_mark_bit(real_ptr);
  535.             /* Delete from hash table */
  536.               next_fo = fo_next(curr_fo);
  537.               if (prev_fo == 0) {
  538.                 fo_head[i] = next_fo;
  539.               } else {
  540.                 fo_set_next(prev_fo, next_fo);
  541.               }
  542.               GC_fo_entries--;
  543.             /* Add to list of objects awaiting finalization.    */
  544.               fo_set_next(curr_fo, GC_finalize_now);
  545.               GC_finalize_now = curr_fo;
  546. #        ifdef PRINTSTATS
  547.               if (!GC_is_marked((ptr_t)curr_fo)) {
  548.                 ABORT("GC_finalize: found accessible unmarked object\n");
  549.               }
  550. #        endif
  551.             curr_fo = next_fo;
  552.         } else {
  553.             prev_fo = curr_fo;
  554.             curr_fo = fo_next(curr_fo);
  555.         }
  556.       }
  557.     }
  558.   /* Remove dangling disappearing links. */
  559.     for (i = 0; i < dl_size; i++) {
  560.       curr_dl = dl_head[i];
  561.       prev_dl = 0;
  562.       while (curr_dl != 0) {
  563.         real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
  564.         if (real_link != 0 && !GC_is_marked(real_link)) {
  565.             next_dl = dl_next(curr_dl);
  566.             if (prev_dl == 0) {
  567.                 dl_head[i] = next_dl;
  568.             } else {
  569.                 dl_set_next(prev_dl, next_dl);
  570.             }
  571.             GC_clear_mark_bit((ptr_t)curr_dl);
  572.             GC_dl_entries--;
  573.             curr_dl = next_dl;
  574.         } else {
  575.             prev_dl = curr_dl;
  576.             curr_dl = dl_next(curr_dl);
  577.         }
  578.       }
  579.     }
  580. }
  581.  
  582. /* Invoke finalizers for all objects that are ready to be finalized.    */
  583. /* Should be called without allocation lock.                */
  584. void GC_invoke_finalizers()
  585. {
  586.     ptr_t real_ptr;
  587.     register struct finalizable_object * curr_fo;
  588.     DCL_LOCK_STATE;
  589.     
  590.     while (GC_finalize_now != 0) {
  591. #    ifdef THREADS
  592.         DISABLE_SIGNALS();
  593.         LOCK();
  594. #    endif
  595.         curr_fo = GC_finalize_now;
  596. #    ifdef THREADS
  597.          if (curr_fo != 0) GC_finalize_now = fo_next(curr_fo);
  598.         UNLOCK();
  599.         ENABLE_SIGNALS();
  600.         if (curr_fo == 0) break;
  601. #    else
  602.         GC_finalize_now = fo_next(curr_fo);
  603. #    endif
  604.         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
  605.         (*(curr_fo -> fo_fn))(real_ptr, curr_fo -> fo_client_data);
  606. #    ifndef THREADS
  607.             GC_free((extern_ptr_t)curr_fo);
  608. #    endif
  609.     }
  610. }
  611.  
  612. # ifdef __STDC__
  613.     extern_ptr_t GC_call_with_alloc_lock(GC_fn_type fn, extern_ptr_t client_data)
  614. # else
  615.     extern_ptr_t GC_call_with_alloc_lock(fn, client_data)
  616.     GC_fn_type fn;
  617.     extern_ptr_t client_data;
  618. # endif
  619. {
  620.     extern_ptr_t result;
  621.     DCL_LOCK_STATE;
  622.     
  623. #   ifdef THREADS
  624.       DISABLE_SIGNALS();
  625.       LOCK();
  626. #   endif
  627.     result = (*fn)(client_data);
  628. #   ifdef THREADS
  629.       UNLOCK();
  630.       ENABLE_SIGNALS();
  631. #   endif
  632.     return(result);
  633. }
  634.  
  635.